home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 11 / Amiga Format AFCD11 (Feb 1997, Issue 95).iso / -seriously_amiga- / commercial / ppaint7demo / rexx / animtext.pprx < prev    next >
Text File  |  1997-01-31  |  11KB  |  475 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1995, 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: AnimText.pprx 1.1 */
  4.  
  5. /** ENG
  6.   This script renders a text string using AnimFonts by Kara Computer
  7.   Graphics. The resulting animation is played or placed in the current
  8.   brush.
  9. */
  10.  
  11. /** DEU
  12.   Dieses Skript erzeugt unter Verwendung der AnimFonts von Kara
  13.   Computer Graphics eine Zeichenfolge. Die daraus resultierende
  14.   Animation wird wahlweise abgespielt oder im aktuellen Brush
  15.   abgelegt.
  16. */
  17.  
  18. absh_dir = 'PPaint:AnimBrushes/AnimFonts'
  19. data_dir = 'PPaint:AnimBrushes/AnimFonts'
  20.  
  21. IF ARG(1, EXISTS) THEN
  22.     PARSE ARG PPPORT
  23. ELSE
  24.     PPPORT = 'PPAINT'
  25.  
  26. IF ~SHOW('P', PPPORT) THEN DO
  27.     IF EXISTS('PPaint:PPaint') THEN DO
  28.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  29.         DO 30 WHILE ~SHOW('P',PPPORT)
  30.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  31.         END
  32.     END
  33.     ELSE DO
  34.         SAY "Personal Paint could not be loaded."
  35.         EXIT 10
  36.     END
  37. END
  38.  
  39. IF ~SHOW('P', PPPORT) THEN DO
  40.     SAY 'Personal Paint Rexx port could not be opened'
  41.     EXIT 10
  42. END
  43.  
  44. ADDRESS VALUE PPPORT
  45. OPTIONS RESULTS
  46. OPTIONS FAILAT 10000
  47.  
  48. Get 'LANG'
  49. IF RESULT = 1 THEN DO        /* Deutsch */
  50. END
  51. ELSE IF RESULT = 1 THEN DO        /* Deutsch */
  52.     txt_title_req     = 'AnimText-Einstellungen'
  53.     txt_gad_lst       = 'Anim_Font:'
  54.     txt_gad_str       = '_Text:'
  55.     txt_string_str    = 'Text'
  56.     txt_gad_cyc       = '_Darstellen:'
  57.     txt_gad_cyc0      = 'Von Links nach Rechts'
  58.     txt_gad_cyc1      = 'Gleichzeitig'
  59.     txt_gad_num0      = 'Ab_stand:'
  60.     txt_gad_num1      = 'Einzelbild-_Offset:'
  61.     txt_gad_chk       = 'Anim-_Brush:'
  62.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  63.     txt_err_noafonts  = 'AnimFonts konnten nicht_gefunden werden'
  64.     txt_err_nodfile   = 'Fontdatei konnte nicht_gefunden werden'
  65.     txt_err_noenv     = 'Andere Umgebung_kann nicht erstellt werden'
  66. END
  67. ELSE IF RESULT = 3 THEN DO    /* Français */
  68.     txt_title_req     = "Réglages d'AnimText"
  69.     txt_gad_lst       = 'Anim_Font :'
  70.     txt_gad_str       = '_Texte :'
  71.     txt_string_str    = 'Texte'
  72.     txt_gad_cyc       = 'Apparitio_n :'
  73.     txt_gad_cyc0      = 'De gauche à droite'
  74.     txt_gad_cyc1      = 'Simultanément'
  75.     txt_gad_num0      = 'E_spacement :'
  76.     txt_gad_num1      = '_Retard :'
  77.     txt_gad_chk       = '_Brosse animée :'
  78.     txt_err_oldclient = 'Ce script nécessite une nouvelle_version de Personal Paint'
  79.     txt_err_noafonts  = 'AnimFonts non trouvées'
  80.     txt_err_nodfile   = 'Impossible de trouver_le fichier de données_de la police'
  81.     txt_err_noenv     = "Impossible de créer_l'autre environnement"
  82. END
  83. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  84.     txt_title_req     = 'Parametri AnimText'
  85.     txt_gad_lst       = 'Anim_Font:'
  86.     txt_gad_str       = '_Testo:'
  87.     txt_string_str    = 'Testo'
  88.     txt_gad_cyc       = '_Scrittura:'
  89.     txt_gad_cyc0      = 'Da sinistra a destra'
  90.     txt_gad_cyc1      = 'Simultanea'
  91.     txt_gad_num0      = '_Spaziatura:'
  92.     txt_gad_num1      = 'Sp_ostamento:'
  93.     txt_gad_chk       = 'Anim-_Brush:'
  94.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  95.     txt_err_noafonts  = 'Impossibile trovare AnimFont'
  96.     txt_err_nodfile   = 'Impossibile aprire_il file dati'
  97.     txt_err_noenv     = 'Impossibile creare_ambiente alternativo'
  98. END
  99. ELSE DO                /* English */
  100.     txt_title_req     = 'AnimText Settings'
  101.     txt_gad_lst       = 'Anim_Font:'
  102.     txt_gad_str       = '_Text:'
  103.     txt_string_str    = 'Text'
  104.     txt_gad_cyc       = '_Render:'
  105.     txt_gad_cyc0      = 'Left to right'
  106.     txt_gad_cyc1      = 'Simultaneously'
  107.     txt_gad_num0      = '_Spacing:'
  108.     txt_gad_num1      = 'F_rame Offset:'
  109.     txt_gad_chk       = 'Anim-_Brush:'
  110.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  111.     txt_err_noafonts  = 'AnimFonts not found'
  112.     txt_err_nodfile   = 'Font data file_cannot be found'
  113.     txt_err_noenv     = 'Other environment_cannot be created'
  114. END
  115.  
  116. Version 'REXX'
  117. IF RESULT < 7 THEN DO
  118.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  119.     EXIT 10
  120. END
  121.  
  122. FreeBrush
  123. IF RC ~= 0 THEN
  124.     EXIT RC
  125.  
  126. /* Build the list of available AnimFonts */
  127.  
  128. ftot = 0
  129. tmpfname = 'T:pprx_temp.'PRAGMA('ID')
  130. ADDRESS COMMAND 'List >'tmpfname' 'absh_dir' NOHEAD LFORMAT="%s" DIRS'
  131. IF RC = 0 THEN DO
  132.     ADDRESS COMMAND 'Sort 'tmpfname tmpfname'.s'
  133.     IF RC = 0 THEN DO
  134.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  135.         tmpfname = tmpfname'.s'
  136.     END
  137.     IF OPEN('listfile', tmpfname, 'R') THEN DO
  138.         DO FOREVER
  139.             fline = READLN('listfile')
  140.             IF EOF('listfile') THEN BREAK
  141.             ftot = ftot + 1
  142.             fontname.ftot = fline
  143.         END
  144.         CALL CLOSE('listfile')
  145.     END
  146. END
  147. ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  148.  
  149. IF ftot = 0 THEN DO
  150.     RequestNotify 'PROMPT "'txt_err_noafonts'"'
  151.     EXIT 10
  152. END
  153.  
  154.  
  155. /* Build and show the settings requester */
  156.  
  157. font = LoadSet('Font', 0)
  158. txt_string_str = LoadSet('Text', txt_string_str)
  159. render  = LoadSet('Render', 0)
  160. spacing = LoadSet('Spacing', 0)
  161. offset  = LoadSet('Offset', 0)
  162. getbsh  = LoadSet('Getbsh', 1)
  163.  
  164. req = '"LIST = ""'txt_gad_lst'"", 'ftot', 'font', 20, 5'  /* max 5 rows to fit into a 320x200 screen */
  165. DO f = 1 TO ftot
  166.     req = req || ', ""' || fontname.f || '""'
  167. END
  168.  
  169. req = req ||,
  170.     ' STRING = ""'txt_gad_str'"", 256, ""'txt_string_str'"" ' ||,
  171.     'CYCLE = ""'txt_gad_cyc'"", 2, 'render', ""'txt_gad_cyc0'"", ""'txt_gad_cyc1'"" ' ||,
  172.     'INTSTR = ""'txt_gad_num0'"", -32768, 32767, 'spacing' ' ||,
  173.     'INTSTR = ""'txt_gad_num1'"", -32768, 32767, 'offset' ' ||,
  174.     'CHECK = ""'txt_gad_chk'"", 'getbsh' "'
  175.  
  176. Request 'RESIZE "'txt_title_req'"' req
  177. IF RC = 0 THEN DO
  178.     font    = RESULT.1
  179.     text    = RESULT.2
  180.     render  = RESULT.3
  181.     spacing = RESULT.4
  182.     offset  = RESULT.5
  183.     getbsh  = RESULT.6
  184.  
  185.     CALL SaveSet('Font', font)        /* setting persistence */
  186.     CALL SaveSet('Text', text)
  187.     CALL SaveSet('Render', render)
  188.     CALL SaveSet('Spacing', spacing)
  189.     CALL SaveSet('Offset', offset)
  190.     CALL SaveSet('Getbsh', getbsh)
  191. END
  192. ELSE EXIT 0
  193.  
  194. font = font + 1
  195. abshpath = absh_dir'/'fontname.font'/'
  196. dataname = data_dir'/'fontname.font'.data'
  197.  
  198. len = LENGTH(text)
  199. fontdata. = 'undef'
  200.  
  201.  
  202.  
  203. /* Read data file */
  204.  
  205. IF OPEN('datafile', dataname, 'R') THEN DO
  206.     READLN('datafile')
  207.     skip_first = READLN('datafile')
  208.     frm_offset = READLN('datafile')
  209.     DO FOREVER
  210.         fline = READLN('datafile')
  211.         IF EOF('datafile') THEN BREAK
  212.         PARSE VAR fline chr nm spc hdx
  213.         fontdata.name.chr  = nm
  214.         fontdata.space.chr = spc
  215.         fontdata.handx.chr = hdx
  216.     END
  217.     CALL CLOSE('datafile')
  218. END
  219. ELSE DO
  220.     RequestNotify 'PROMPT "'txt_err_nodfile'"'
  221.     EXIT 10
  222. END
  223.  
  224.  
  225.  
  226. /* Render the text */
  227.  
  228. LockGUI
  229.  
  230. Get 'IMAGEW'
  231. img_width = RESULT
  232. Get 'DISPLAY'
  233. img_disp = RESULT
  234.  
  235. SwitchEnvironment
  236. FreeEnvironment 'QUERY'
  237. IF RC ~= 0 THEN DO
  238.     UnlockGUI
  239.     EXIT RC
  240. END
  241.  
  242. Get 'GCLIP'
  243. saveclip = RESULT
  244. Set '"GCLIP=0"'
  245.  
  246. DeleteFrames 'ALL FORCE'
  247. ClearImage
  248. SetPaintMode 'MATTE'
  249. xmax = 0
  250. ymax = 0
  251. error = 0
  252. IF render = 0 THEN DO    /* Left to right */
  253.     xpos = 0
  254.     ypos = 0
  255.     first = 1
  256.     DO c = 1 TO len
  257.         chr = UseChar(SUBSTR(text, c, 1))
  258.         IF chr = 32 | chr = 60 | chr = 62 THEN DO
  259.             IF fontdata.space.chr ~= 'undef' THEN
  260.                 xpos = xpos + fontdata.space.chr + spacing
  261.         END
  262.         ELSE DO
  263.             LoadAnimBrush '"'abshpath || fontdata.name.chr'"' FORCE QUIET NOPROGRESS
  264.             IF RC = 0 THEN DO
  265.                 GetBrushAttributes 'FRAMES'
  266.                 frm = RESULT
  267.                 IF skip_first THEN
  268.                     frm = frm - 1
  269.  
  270.                 IF first THEN DO
  271.                     first = 0
  272.                     error = SetupEnv(img_width, img_disp)
  273.                     IF error ~= 0 THEN
  274.                         LEAVE c
  275.                     UseBrushPalette
  276.                     IF fontdata.handx.chr > 0 THEN
  277.                         xpos = fontdata.handx.chr
  278.  
  279.                     AddFrames frm
  280.                 END
  281.                 ELSE DO
  282.                     GetFrames
  283.                     tot = RESULT
  284.                     pos = tot + frm_offset + offset
  285.                     add = frm - (tot - pos)
  286.                     IF add > 0 THEN
  287.                         AddFrames add 'AFTER' tot
  288.                     SetFramePosition pos + 1
  289.                 END
  290.  
  291.                 SetBrushAttributes 'FRAMEPOSITION 2 HANDLEX' fontdata.handx.chr 'HANDLEY 0'
  292.                 DO f = 1 TO frm
  293.                     PutBrush xpos ypos
  294.                     SetFramePosition 'NEXT'
  295.                 END
  296.  
  297.                 GetBrushAttributes 'WIDTH'
  298.                 x1 = xpos - fontdata.handx.chr + RESULT - 1
  299.                 IF x1 > xmax THEN
  300.                     xmax = x1
  301.                 GetBrushAttributes 'HEIGHT'
  302.                 y1 = ypos + RESULT - 1
  303.                 IF y1 > ymax THEN
  304.                     ymax = y1
  305.                 xpos = xpos + fontdata.space.chr + spacing
  306.             END
  307.         END
  308.     END
  309. END
  310. ELSE DO    /* Simultaneously */
  311.     max_frm = 0
  312.     DO c = 1 TO len
  313.         chr = UseChar(SUBSTR(text, c, 1))
  314.         IF chr ~= 32 & chr ~= 60 & chr ~= 62 THEN DO
  315.             LoadAnimBrush '"'abshpath || fontdata.name.chr'" FORCE QUIET NOPROGRESS'
  316.             IF RC = 0 THEN DO
  317.                 GetBrushAttributes 'FRAMES'
  318.                 frm = RESULT
  319.                 IF frm > max_frm THEN
  320.                     max_frm = frm
  321.             END
  322.         END
  323.     END
  324.     error = SetupEnv(img_width, img_disp)
  325.     IF error = 0 THEN DO
  326.         IF skip_first THEN
  327.             max_frm = max_frm - 1
  328.         UseBrushPalette
  329.         AddFrames max_frm
  330.  
  331.         DO f = 1 TO max_frm
  332.             xpos = 0
  333.             ypos = 0
  334.             first = 1
  335.             DO c = 1 TO len
  336.                 chr = UseChar(SUBSTR(text, c, 1))
  337.                 IF chr = 32 | chr = 60 | chr = 62 THEN DO
  338.                     IF fontdata.space.chr ~= 'undef' THEN
  339.                         xpos = xpos + fontdata.space.chr + spacing
  340.                 END
  341.                 ELSE DO
  342.                     LoadAnimBrush '"'abshpath || fontdata.name.chr'" FORCE QUIET NOPROGRESS'
  343.                     IF RC = 0 THEN DO
  344.                         GetBrushAttributes 'FRAMES'
  345.                         frm = RESULT
  346.  
  347.                         IF first THEN DO
  348.                             first = 0
  349.                             IF fontdata.handx.chr > 0 THEN
  350.                                 xpos = fontdata.handx.chr
  351.                         END
  352.                         fpos = f + 1
  353.                         IF fpos > frm THEN DO
  354.                             IF skip_first THEN
  355.                                 fpos = frm
  356.                             ELSE
  357.                                 fpos = 1
  358.                         END
  359.                         SetBrushAttributes 'FRAMEPOSITION' fpos 'HANDLEX' fontdata.handx.chr 'HANDLEY 0'
  360.                         PutBrush xpos ypos
  361.  
  362.                         IF f = 1 THEN DO
  363.                             GetBrushAttributes 'WIDTH'
  364.                             x1 = xpos - fontdata.handx.chr + RESULT - 1
  365.                             IF x1 > xmax THEN
  366.                                 xmax = x1
  367.                             GetBrushAttributes 'HEIGHT'
  368.                             y1 = ypos + RESULT - 1
  369.                             IF y1 > ymax THEN
  370.                                 ymax = y1
  371.                         END
  372.                         xpos = xpos + fontdata.space.chr + spacing
  373.                     END
  374.                 END
  375.             END
  376.             SetFramePosition 'NEXT'
  377.         END
  378.     END
  379. END
  380.  
  381. IF error = 0 THEN DO
  382.     SetFramePosition 1
  383.     IF getbsh THEN DO
  384.         GetFrames
  385.         frm = RESULT
  386.         DefineBrush 0 0 xmax ymax frm
  387.         IF RC = 0 THEN
  388.             FreeEnvironment 'FORCE'
  389.     END
  390.     ELSE DO
  391.         FreeBrush 'FORCE'
  392.         Play 'FORCE'
  393.     END
  394. END
  395. ELSE
  396.     RequestNotify 'PROMPT "'txt_err_noenv'"'
  397.  
  398. Set '"GCLIP='saveclip'"'
  399. UnlockGUI
  400. EXIT 0
  401.  
  402.  
  403.  
  404.  
  405. UseChar:
  406.     ch = ARG(1)
  407.  
  408.     code = C2D(ch)
  409.  
  410.     IF fontdata.space.code = 'undef' THEN DO
  411.         IF ch >= 'A' & ch <= 'Z' THEN
  412.             code = code + 32
  413.         ELSE IF ch >= 'a' & ch <= 'z' THEN
  414.             code = code - 32
  415.  
  416.         IF fontdata.space.code = 'undef' THEN
  417.             code = 32
  418.     END
  419.  
  420.     RETURN code
  421.  
  422.  
  423.  
  424.  
  425. SetupEnv:
  426.     imgw = ARG(1)
  427.     imgd = ARG(2)
  428.  
  429.     GetBrushAttributes 'COLORS'
  430.     cnum = RESULT
  431.     GetBrushAttributes 'HEIGHT'
  432.     imgh = RESULT
  433.  
  434.     Set '"IMAGEW='imgw'" "IMAGEH='imgh'" "COLORS='cnum'" "DISPLAY='imgd'" "SCREENW=-1" "SCREENH='imgh'" "ASCROLL=0"'
  435.  
  436.     RETURN RC
  437.  
  438.  
  439.  
  440.  
  441. SaveSet:
  442.     sname = ARG(1)
  443.     val = ARG(2)
  444.  
  445.     IF OPEN('settingfile', 'ENV:PP_AnimText_'sname, 'W') THEN DO
  446.         CALL WRITECH('settingfile', val)
  447.         CALL CLOSE('settingfile')
  448.     END
  449.  
  450.     RETURN
  451.  
  452.  
  453.  
  454.  
  455. LoadSet:
  456.     sname = ARG(1)
  457.     def_val = ARG(2)
  458.  
  459.     val = def_val
  460.     IF OPEN('settingfile', 'ENV:PP_AnimText_'sname, 'R') THEN DO
  461.         val = READCH('settingfile', 65535)
  462.         CALL CLOSE('settingfile')
  463.     END
  464.  
  465.     /* encode quotes for the Request command ('"' -> '\""') */
  466.     qpos_start = 1
  467.     DO FOREVER
  468.         qpos = INDEX(val, '"', qpos_start)
  469.         IF qpos = 0 THEN BREAK
  470.         val = INSERT('\"', val, qpos-1)
  471.         qpos_start = qpos + 3
  472.     END
  473.  
  474.     RETURN val
  475.